home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / RTPC10 / DJDUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-20  |  5KB  |  105 lines
  1. {
  2.   ┌────────┬──────────────────────────────────────────────────────┐
  3.   │Name    │ DJDUMP.PAS                                           │
  4.   ├────────┼──────────────────────────────────────────────────────┤
  5.   │Use     │ Just an example procedure for TP6 and above.         │
  6.   │        │ Dumps a 640x480x16 VGA screen to the HP DeskJet on   │
  7.   │        │ LPT1 in 16 gray scales.                              │
  8.   ├────────┼──────────────────────────────────────────────────────┤
  9.   │By      │ Rafe Aldridge - (C) Copyright 1993                   │
  10.   └────────┴──────────────────────────────────────────────────────┘
  11.   ┌───────────────────────────────────────────────────────────────┐
  12.   │ Please realise that this program present's an idea. No claim  │
  13.   │ is made that it is well written or cannot be improved upon    │
  14.   └───────────────────────────────────────────────────────────────┘
  15.   ┌───────────────────────────────────────────────────────────────┐
  16.   │ Rafe's TP Collection is SHAREWARE                             │
  17.   ├───────────────────────────────────────────────────────────────┤
  18.   │                                                               │
  19.   │ If you find any part of Rafe's TP Collection usefull then     │
  20.   │ please become a registered user by sending 10 Pounds Sterling │
  21.   │ to the address below. In return you will recieve the LATEST   │
  22.   │ FULL source code to ALL the units as well anything new.       │
  23.   │                                                               │
  24.   │ Please feel free to write with suggestions, ideas or money to │
  25.   │     Rafe Aldridge,                                            │
  26.   │     Street Farm,                                              │
  27.   │     Dereham Road,                                             │
  28.   │     Garvestone,                                               │
  29.   │     Norfolk.                                                  │
  30.   │     NR9 4QT                                                   │
  31.   │     ENGLAND                                                   │
  32.   │                                                               │
  33.   └───────────────────────────────────────────────────────────────┘
  34. }
  35.  
  36. uses printer;
  37.  
  38. Procedure DJDUMP;
  39. Const
  40.   grayscale : array [0..15,0..3] of byte = ((00,00,00,00),
  41.                                             (00,02,00,00),
  42.                                             (00,08,00,02),
  43.                                             (00,10,00,02),
  44.                                             (05,00,05,00),
  45.                                             (05,02,05,00),
  46.                                             (05,08,05,02),
  47.                                             (05,10,05,02),
  48.                                             (10,05,10,05),
  49.                                             (10,07,10,05),
  50.                                             (10,13,10,07),
  51.                                             (10,16,10,07),
  52.                                             (16,05,16,05),
  53.                                             (16,07,16,05),
  54.                                             (16,13,16,07),
  55.                                             (16,16,16,07));
  56.  
  57.   maxx  : word = 639;
  58.   maxy  : word = 239; { half of max.y pixels }
  59.   graph_start : string = #27'E'#27'&l0O'#27'*t300R'#27'*r2Q';
  60.   graph_finish : string = #27'*rbC0C'#27'E';
  61.   graph_init : string = #27'*b240W';
  62.   graph_end : string = #27'*rbC';
  63.  
  64. Var
  65.   x,y : word;
  66.   a : array [0..3] of string;
  67.   s,g,p1,p2 : byte;
  68.  
  69. function pix (px,py : word) : byte; assembler; { get pixel from screen }
  70. asm
  71.   mov ax,0D00h
  72.   mov bx,0
  73.   mov cx,px
  74.   mov dx,py
  75.   int 10h
  76. end;
  77.  
  78. Begin
  79.   write (lst,graph_start); { reset printer, open graphics }
  80.   for s:=0 to 3 do a[s][0]:=chr(240);
  81.   for x:=0 to maxx do  { x axis loop }
  82.     begin
  83.       for y:=maxy downto 0 do { y axis loop }
  84.         begin
  85.           p1:=pix(x,(y*2)+1);
  86.           p2:=pix(x,(y*2));
  87.           for s:=0 to 3 do
  88.             begin
  89.               g:=0;
  90.               g:=grayscale [p1,s];
  91.               g:=g shl 4;
  92.               g:=g OR grayscale [p1,s];
  93.               a[s][y+1]:=chr(g);
  94.             end; { first s loop }
  95.           for s:=0 to 3 do
  96.             begin
  97.               write (lst,graph_init);
  98.               write (lst,a[s]);
  99.               write (lst,graph_end);
  100.             end; { second s loop }
  101.         end; { y loop }
  102.     end; { x loop }
  103.   write (lst,graph_finish); { close down graphics, reset printer }
  104. end;
  105.